perm filename FRED.PR[E81,JMC] blob sn#602246 filedate 1981-07-24 generic text, type T, neo UTF8
nott(P) :- P, !, fail.
nott(←).

assoc(X,[],[]).
assoc(X,[[X|Y]|L],[X|Y]) :- !.
assoc(X,[[X1|Y]|L],W) :- X\==X1,assoc(X,L,W).

colored(X,U,[[X|W]|C]) :- iscolor(W),!,W=U.
colored(X,U,[[Y|W]|C]) :- colored(X,U,C).

iscolor(y).
iscolor(b).
iscolor(r).
iscolor(g).

ok([],[]).
ok([[X|U]|C],[[X|L]|M]) :- compatible(X,U,L,C) , ok(C,M).

compatible(X,U,[],C).
compatible(X,U,[Y|L],C) :- colored(Y,V,C),n(U,V),compatible(X,U,L,C).

n(U,V) :- U \== V.

color(M,L,C) :- removable(M,L,X),!,color(M,[X|L],C).
color(M,L,C) :- color1([M|L],M1),fillin([M|L],M1,C).

color1(X,[]).

removable([[X|U]|M],L,X) :- nott(member(X,L)), lthree(U,L).
removable([[Y|U]|M],L,X) :- Y \== X,removable(M,L,X).

lthree([],L).
lthree([X|U],L) :- member(X,L),lthree(U,L).
lthree([X|U],L) :- ltwo(U,L).
ltwo([],L).
ltwo([X|U],L) :- member(X,L),ltwo(U,L).
ltwo([X|U],L) :- lone(U,L).
lone([],L).
lone([X|U],L) :- member(X,L),lone(U,L).
lone([X],L).

member(H,[H|←]) :- !.
member(I,[←|T]) :- member(I,T).

member1(H,[H|←]).
member1(I,[←|T]) :- member1(I,T).

fillin([M|[]],C,C).
fillin([M|[X|L]],C,W) :- 	assoc(X,M,[X|U]),
				iscolor(Z),
				nott(conflicts(U,C,Z)),
				fillin([M|L],[[X|Z]|C],W).

conflicts(U,C,Z) :- member1(Y,U),assoc(Y,C,[Y|Z]).

cp(X) :- color([[r1,r2,r3,r5,r6],[r2,r1,r3,r4,r5,r6],[r3,r1,r2,r4,r6],
[r4,r2,r3],[r5,r1,r2,r6],[r6,r1,r2,r3,r5]],[],X).